-- ghci -XNoMonomorphismRestriction
module FdType where

import Control.Monad.Error
import Data.IORef
import Text.ParserCombinators.Parsec
import System.IO.Unsafe(unsafePerformIO)


type Id = String

-- env, to hold vars
type Env = IORef [(Id, IORef Val)] 

-- types in val 
type Func = ([Val] -> Fineday Val) 

type ArrayRef a = IORef [IORef a]

type HashRef = IORef [(Val, Val)]

instance (Show a) => Show (ArrayRef a) where
	show arrRef = unsafePerformIO $ do {
		arr <- readIORef arrRef;
		liftM show $ mapM readIORef arr;
	}
instance Show HashRef where
	show hsRef = unsafePerformIO $ do {
		hs <- readIORef $ hsRef;
		return $ concat [ "\n{\n", (unlines $ map (\(k, v)-> concat ["\t", show k, " => ", show v, ","]) hs), "}"];
	}

-----------------------------------------------------------
-- # structure
-----------------------------------------------------------
data Expr
	= If               [(Expr,Expr)] Expr 
	| Case             Expr [(Expr, Expr)] Expr
	| While            Expr Expr
	| Break
	| Return           Expr
	| Seq              [Expr]
	| Apply            Expr [Expr]
	| Assign           Expr Expr
	| Define           Id Expr
	| ArrayItem        Expr Expr
    | Value            Val
    | Literal          Literal
	| Ident            Id
	| Nop
    deriving (Eq, Show)

data Literal
    = NumberL    Double
    | BoolL      Bool
    | StringL    String
	| ArrayL     [Expr]
	| HashL      [(Expr, Expr)]
	| FunctionL  [Id] Expr
    | NilL
    deriving (Eq, Show)

data Val
	= Number     Double
	| Bool       Bool
	| String     (ArrayRef Char)
	| Array      (ArrayRef Val)
	| Hash       HashRef
	| Function   Func
	| Nil

instance Show Val where
	show val@(Nil)        = "nil"
	show val@(Function _) = "function(){...}"
	show val@(String a)   = show a
	show val@(Number a)   = show a
	show val@(Bool   a)   = show a
	show val@(Array  a)   = show a
	show val@(Hash   a)   = show a

instance Eq Val where
    (==) Nil        Nil        = True
    (==) (Number a) (Number b) = (a==b)
    (==) (Bool a)   (Bool b)   = (a==b)
    (==) (Array a)  (Array b)  = (a==b)
    (==) (String a) (String b) = unsafePerformIO $ do {
        [a, b] <- mapM readIORef [a,b];
        [a, b] <- mapM (mapM readIORef) [a, b];
        return (a==b);
    }
    (==) _ _                   = False


-----------------------------------------------------------
-- # TODO : all about basic types 
-----------------------------------------------------------

-----------------------------------------------------------
-- # error handling
-----------------------------------------------------------
data Err 
	= SyntaxErr String
	| TypeErr String
	| NameErr String
	| ParamErr Int Int
	| Default String

type ThrowsError = Either Err
type IOThrowsError = ErrorT Err IO

type Fineday = IOThrowsError

instance Show Err where
    show (SyntaxErr msg)            = "SyntaxError: " ++ msg
    show (TypeErr msg)              = "TypeError: " ++ msg
    show (NameErr id)               = "NameError: undefined local variable or function: '"++ id ++ "'"
    show (ParamErr a b)             = "ParamError: wrong number of parameters (" ++ (show a) ++" for "++ (show b) ++")"
    show (Default msg)              = "Error: " ++ msg

instance Error Err where
	noMsg = Default "a error occured"
	strMsg = Default

extractValue :: ThrowsError a -> a
extractValue (Right val) = val

liftThrows :: ThrowsError a -> Fineday a
liftThrows (Left err) = throwError err
liftThrows (Right val) = return val

--runIOThrows :: Fineday a -> IO a 
--runIOThrows action = runErrorT $ catchError (liftM show $ action) (return . show);
runIOThrows action = runErrorT $ catchError (do { result <- action; return $ show result;}) 
											(return . show);
                                            
runFineday = runIOThrows
